# load omnibus dataframe
omnibus_df <- read_delim("../data/processed/omnibus/omnibus_raw.csv",
delim = ",",
col_types = cols(
.default = col_double(),
type = col_factor(),
ppid = col_factor(),
exp_label = col_factor(),
experiment = col_factor(),
hand = col_factor(),
camera_tilt = col_factor(),
surface_tilt = col_factor(),
target = col_factor(),
test_type = col_factor(),
prior_anim = col_factor(),
baseline_block = col_factor(),
task_type = col_factor(),
surface = col_factor(),
anim_type = col_factor()
)
) %>% # filter out practice blocks
filter(block_num > 4)
# Optionally make learning rate summaries
# do the following if learning_rate_df.csv doesn't exist in ../data/processed
# This takes a loong time
if (!file.exists("../data/processed/learning_rate_df.csv")) {
print(Sys.time())
apply_exponentialFit <- function(df) {
df %>%
summarise(
ppid = first(ppid),
experiment = first(experiment),
test_type = first(test_type),
exponentialFit2 = exponentialFit(norm_throw_deviation, mode = test_type[1])
)
}
block_init_learning_rates <- omnibus_df %>%
filter(str_detect(test_type, "init")) %>%
group_by(ppid, experiment, test_type) %>%
group_split() %>%
future_map(apply_exponentialFit) %>%
bind_rows() %>%
unnest(cols = c('exponentialFit2'))
print("done")
print(Sys.time())
write_csv(block_init_learning_rates, "../data/processed/learning_rate_df.csv")
} else {
print("learning_rate_df.csv exists, loading from file")
block_init_learning_rates <- read_csv("../data/processed/learning_rate_df.csv",
col_types = cols(
.default = col_double(),
experiment = col_factor(),
test_type = col_factor()
))
}
[1] "2023-06-22 00:20:43 EDT"
[1] "done"
[1] "2023-06-22 00:22:47 EDT"
Vectors representing the throw velocity (trace 0) and the velocity applied to the ball (trace 1). The y dimention of the throw is essentially ignored (in reality there is a slight tilt added to account for the tilt of the surface).
test_ppt <- 3
test_df <- omnibus_df %>% filter(ppid == test_ppt)
trial <- 250
trial_df <- filter(test_df, trial_num == trial)
x <- trial_df$flick_velocity_x
y <- trial_df$flick_velocity_y
z <- trial_df$flick_velocity_z
x2 <- trial_df$flick_direction_x * -1
y2 <- trial_df$flick_direction_y * -1
z2 <- trial_df$flick_direction_z * -1
# plot both
p <- plot_ly(x = c(0, x), y = c(0, y), z = c(0, z), type = "scatter3d", mode = "lines") %>%
add_trace(x = c(0, x2), y = c(0, y2), z = c(0, z2), type = "scatter3d", mode = "lines") %>%
layout(scene = list(
xaxis = list(title = "x", range = c(-2, 2)),
yaxis = list(title = "y", range = c(-1, 3)),
zaxis = list(title = "z", range = c(-1, 3))
))
# Render the plot
p
note: this is a rotated trial
# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
x = error_size,
fill = type
)) +
geom_histogram(binwidth = .5, alpha = .6) +
theme_minimal() +
theme(text = element_text(size = 11)) +
scale_fill_manual(values = c("#f9982c", "#d40000")) +
labs(x = "Error Size (cm)", y = "Count")
p
# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
x = throw_deviation,
fill = type
)) +
geom_histogram(binwidth = 1, alpha = .6) +
theme_minimal() +
theme(text = element_text(size = 11)) +
scale_fill_manual(values = c("#f9982c", "#d40000")) +
labs(
x = "Throw Angle (°)", y = "Count"
) + # dashed lines at 0, -15, -30
geom_vline(
xintercept = c(0, -15, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
) + # ticks of 15 degrees
scale_x_continuous(
breaks = c(-30, 0, 30, -60, -90)
)
p
Note: Blues = Acceleration Perturbations
# rest of the exps
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# p <- p +
# scale_y_continuous(
# limits = c(-10, 35),
# breaks = c(0, 15, 30),
# labels = c(0, 15, 30)
# ) +
# scale_x_continuous(
# limits = c(0, 180),
# breaks = c(0, 60, 120, 180),
# labels = c(0, 60, 120, 180)
# )
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
# # save
# if (save_plots) {
# ggsave(
# p,
# filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
# height = 4, width = 6
# )
# }
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / NUM_EXPS),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
Note: Blues = Acceleration Perturbations
# rest of the exps
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(norm_throw_deviation),
ci_deviation = vector_confint(norm_throw_deviation),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# p <- p +
# scale_y_continuous(
# limits = c(-10, 35),
# breaks = c(0, 15, 30),
# labels = c(0, 15, 30)
# ) +
# scale_x_continuous(
# limits = c(0, 180),
# breaks = c(0, 60, 120, 180),
# labels = c(0, 60, 120, 180)
# )
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
# # save
# if (save_plots) {
# ggsave(
# p,
# filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
# height = 4, width = 6
# )
# }
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / NUM_EXPS),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
data_ppt <- block_init_learning_rates %>%
filter(experiment != "a_ball_roll_animate_surface")
data_group <- data_ppt %>%
group_by(experiment, test_type) %>%
summarise(
mean_learning_rate = mean(exp_fit_lambda),
ci_learning_rate = vector_confint(exp_fit_lambda),
mean_high = mean(exp_fit_N0),
ci_high = vector_confint(exp_fit_N0),
# mean_low = mean(exp_fit_displace),
# ci_low = vector_confint(exp_fit_displace),
.groups = "drop"
)
p <- data_group %>%
ggplot(
aes(x = experiment, y = mean_learning_rate, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Learning Rate"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7 Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_ppt,
aes(
y = exp_fit_lambda
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_learning_rate - ci_learning_rate,
ymax = mean_learning_rate + ci_learning_rate
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
p <- data_group %>%
ggplot(
aes(x = experiment, y = mean_high, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "High Point"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7 Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_ppt,
aes(
y = exp_fit_N0
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_high - ci_high,
ymax = mean_high + ci_high
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
# p <- data_group %>%
# ggplot(
# aes(x = experiment, y = mean_low, colour = experiment)
# ) +
# theme_classic() +
# labs(
# x = NULL,
# y = "Low Point"
# ) +
# facet_wrap(~test_type)
#
# # remove all x axis labels
# p <- p + theme(axis.text.x = element_blank())
#
# # for the colour legend, only show the first 7 Note this doesn't work for the plotly plot
# p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
#
# # add data points
# p <- p +
# geom_beeswarm(
# data = data_ppt,
# aes(
# y = exp_fit_displace
# ),
# alpha = 0.1,
# size = 1
# ) +
# geom_linerange(aes(
# ymin = mean_low - ci_low,
# ymax = mean_low + ci_low
# ), alpha = 0.5, lwd = 2) +
# geom_point()
#
# # set colour palette
# p <- p +
# scale_colour_manual(values = pallete_list) +
# scale_fill_manual(values = pallete_list)
#
# ggplotly(p)
# # p
For washout: The CUED accel + curved have a lower starting point (therefore – cue works). VMR group has slightly lower. When comparing everything with a high starting point, the ACCEL group has a much higher learning rate.
When transferring, no difference in learning rates.
### TESTING
# rest of the exps
data_ <- omnibus_df %>%
filter(experiment == "accel_uncued", test_type == "washout_init")
# set up plot
p <- data_ %>%
ggplot(
aes(
x = trial_num, y = norm_throw_deviation, colour = ppid
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# p <- p +
# scale_y_continuous(
# limits = c(-10, 35),
# breaks = c(0, 15, 30),
# labels = c(0, 15, 30)
# ) +
# scale_x_continuous(
# limits = c(0, 180),
# breaks = c(0, 60, 120, 180),
# labels = c(0, 60, 120, 180)
# )
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_line()
# # save
# if (save_plots) {
# ggsave(
# p,
# filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
# height = 4, width = 6
# )
# }
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# original experiments only
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(error_size),
ci_deviation = vector_confint(error_size),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Absolute Target Error (cm)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 40), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(20), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# p <- p +
# scale_y_continuous(
# limits = c(-10, 35),
# breaks = c(0, 15, 30),
# labels = c(0, 15, 30)
# ) +
# scale_x_continuous(
# limits = c(0, 180),
# breaks = c(0, 60, 120, 180),
# labels = c(0, 60, 120, 180)
# )
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
# # save
# if (save_plots) {
# ggsave(
# p,
# filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
# height = 4, width = 6
# )
# }
ggplotly(p)
# p
visible vs non-visible tilt doesn’t affect the 15-degree rotation condition. But affects all other conditions. So 15-degree rotation
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / NUM_EXPS),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Absolute Target Error (cm)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 40), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(20), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# isolate animate_surface exp
data_per_group <- omnibus_df %>%
filter(exp_label == "animate_surface") %>%
group_by(prior_anim, block_num, trial_num_in_block, trial_num) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation)
)
# order the factors for assigning colour pallets
data_per_group$prior_anim <- factor(
data_per_group$prior_anim,
levels = c(
"none", "half_anim", "full_anim"
)
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation,
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# p <- p +
# scale_y_continuous(
# limits = c(-10, 35),
# breaks = c(0, 15, 30),
# labels = c(0, 15, 30)
# ) +
# scale_x_continuous(
# limits = c(0, 180),
# breaks = c(0, 60, 120, 180),
# labels = c(0, 60, 120, 180)
# )
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# repeat for prior_anim == "half", "full" and "wait"
for (unique_prior_anim in unique(data_per_group$prior_anim)) {
# get the data for this block
to_plot_data <- filter(data_per_group, prior_anim == unique_prior_anim)
# loop through the unique blocks in to_plot_data
for (block in unique(to_plot_data$block_num)) {
# get the data for this block
block_data <- filter(to_plot_data, block_num == block)
# add the data, use the pallete_list to get the colour
p <- p + geom_ribbon(
data = block_data,
aes(fill = prior_anim),
colour = NA, alpha = 0.3
) + geom_line(
data = block_data,
aes(colour = prior_anim)
)
}
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
# # save
# if (save_plots) {
# ggsave(
# p,
# filename = "../plots/paper_figs/sr_30_training.pdf", device = "pdf",
# height = 4, width = 6
# )
# }
ggplotly(p)
# p
# first, isolate the data
data <- omnibus_df %>%
filter(
exp_label == "animate_surface",
baseline_block == FALSE,
test_type == "washout_anim"
)
data_per_ppt <- data %>%
group_by(ppid, prior_anim, trial_num_in_block) %>%
summarise(
ppt_mean_deviation = median(throw_deviation),
ppt_ci_deviation = vector_confint(throw_deviation),
n = n()
)
data_per_group <- data_per_ppt %>%
group_by(prior_anim, trial_num_in_block) %>%
summarise(
mean_deviation = mean(ppt_mean_deviation),
ci_deviation = vector_confint(ppt_mean_deviation),
n = sum(n)
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num_in_block, y = mean_deviation,
colour = prior_anim, fill = prior_anim
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number in Block",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add data points
p <- p + geom_beeswarm(
data = data_per_ppt,
aes(
y = ppt_mean_deviation,
colour = prior_anim
),
size = 1, dodge.width = 0.5
) + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# ggplotly(plot_success_manifold_no_tilt())
plot_success_manifold_no_tilt()
ggplotly(plot_success_manifold_tilt())